PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/fcsrc.exe/FCDLGS.PAS

Pascal/Delphi Source File | 1992-06-04 | 14.2 KB | 542 lines

unit FCDLGS;

{$R FCDLGS}

interface

uses WinTypes, WinProcs, WObjects, WinDOS, Strings;

{$I fc.inc}

const
    id_DirDlg                    = 400;
    id_DirListbox            = 401;
    id_DirPrompt            = 402;

    id_ExeDlg                    = 410;
    id_ExePrompt            = 411;
    id_ExeFilebox            = 412;
    id_ExeDirbox            = 413;
    id_ExeFilePrompt    = 414;

  id_SaveAsDlg            = 420;
  id_Namebox                = 421;

  id_SctnDlg                 = 430;
    id_SctnList             = 431;

  id_SetupDlg                = 440;
  id_ItmEdit                = 441;
  id_GrpCombo                = 442;
  id_InstallBtn            = 443;

type
    PDirDlg    = ^TDirDlg;
    TDirDlg    = object(TDialog)
        Buffer: PChar;
        constructor Init(AParent: PWindowsObject; ABuffer: PChar);
        procedure SetupWindow; virtual;
        procedure MsgDirListbox(var Msg: TMessage);
        virtual id_First + id_DirListbox;
    procedure Ok(var Msg: TMessage); virtual id_First + id_Ok;
     end;

    PExeDlg = ^TExeDlg;
    TExeDlg = object(TDialog)
        Buffer: PChar;
    FileBox: PListBox;
        constructor Init(AParent: PWindowsObject; ABuffer: PChar);
        procedure SetupWindow; virtual;
        procedure MsgExeFilebox(var Msg: TMessage);
        virtual id_First + id_ExeFilebox;
        procedure MsgExeDirbox(var Msg: TMessage);
        virtual id_First + id_ExeDirbox;
    procedure Ok(var Msg: TMessage);
        virtual id_First + id_Ok;
    end;

  PSaveAsDlg = ^TSaveAsDlg;
  TSaveAsDlg = object(TDialog)
      Buffer: PChar;
    NameBox: PEdit;
    constructor Init(AParent: PWindowsObject; ABuffer: PChar);
    procedure SetupWindow; virtual;
    function CanClose: Boolean; virtual;
  end;

type
    PSctnDlg = ^TSctnDlg;
    TSctnDlg = object(TDialog)
    Buffer: PChar;
    BufferSize: Word;
    SctnList: PListbox;
    OkBtn: PButton;
    constructor Init(AParent: PWindowsObject; ABuffer: PChar;
        ABufferSize: Word);
    function CanClose: Boolean; virtual;
        procedure SetupWindow; virtual;
        procedure CMSctnList(var Msg: TMessage);
        virtual id_First + id_SctnList;
  end;

    PPmGroup = ^TPmGroup;
    TPmGroup = object(TObject)
        Filename: Array[0..100] of Char;
        Title   : Array[0..100] of Char;
        constructor Init;
        procedure NextGroup(AFilename: PChar);
    end;

  PInstallDlg = ^TInstallDlg;
  TInstallDlg = object(TDialog)
      SectionName: PChar;
    TheItm, TheGrp: PChar;
      ItmEdit: PEdit;
    GrpCombo: PCombobox;
    ServerWindow: HWnd;
    PendingMessage: Word;
      constructor Init(AParent: PWindowsObject;
        ASectionName, AnItm, AGrp: PChar);
    procedure SetupWindow; virtual;
    procedure CMInstall(var Msg: TMessage);
        virtual id_First + id_InstallBtn;
    procedure WMDDEAck(var Msg: TMessage);
        virtual wm_First + wm_DDE_Ack;
    procedure WMDDETerminate(var Msg: TMessage);
        virtual wm_First + wm_DDE_Terminate;
    procedure WMDestroy(var Msg: TMessage);
        virtual wm_First + wm_Destroy;
    procedure InitiateDDE;
    procedure TerminateDDE;
  end;

implementation

{ ----- TDirDlg methods ---------------------------------------------- }

constructor TDirDlg.Init(AParent: PWindowsObject; ABuffer: PChar);
var
    AControl: PControl;
begin
    TDialog.Init(AParent, PChar(id_DirDlg));
  Buffer := ABuffer;
    AControl := New(PListBox, InitResource(@Self, id_DirListbox));
  AControl := New(PStatic, InitResource(@Self, id_DirPrompt,
      fsPathName+1));
end;

procedure TDirDlg.SetupWindow;
begin
    DlgDirList(HWindow, GetCurDir(Buffer, 0), id_DirListbox,
      id_DirPrompt, $C010);
end;

procedure TDirDlg.MsgDirListbox(var Msg: TMessage);
begin
    if Msg.LParamHi = lbn_DblClk then
    begin
        DlgDirSelect(HWindow, Buffer, id_DirListbox);
        FileExpand(Buffer, Buffer);
        DlgDirList(HWindow, Buffer, id_DirListbox, id_DirPrompt, $C010);
    end;
end;

procedure TDirDlg.Ok(var Msg: TMessage);
var
    Len: Integer;
begin
    Buffer[0] := #0;
    DlgDirSelect(HWindow, Buffer, id_DirListbox);
  if StrIComp(Buffer, '') = 0 then
  begin
      FileExpand(Buffer, Buffer);
      Len := StrLen(Buffer) - 1;
      if Buffer[Len] = '\' then
          Buffer[Len] := #0;
      TDialog.Ok(Msg);
  end
  else
  begin
        FileExpand(Buffer, Buffer);
        DlgDirList(HWindow, Buffer, id_DirListbox, id_DirPrompt, $C010);
    end;
end;

{ ---- TExeDlg methods -------------------------------------------------- }

constructor TExeDlg.Init(AParent: PWindowsObject; ABuffer: PChar);
var
    AControl: PControl;
begin
    TDialog.Init(AParent, PChar(id_ExeDlg));
    Buffer := ABuffer;
  FileBox := New(PListBox, InitResource(@Self, id_ExeFilebox));
    AControl := New(PListBox, InitResource(@Self, id_ExeDirbox));
    AControl := New(PStatic, InitResource(@Self, id_ExePrompt,
      fsPathName+1));
  AControl := New(PStatic, InitResource(@Self, id_ExeFilePrompt,
      fsPathName+1));
end;

procedure TExeDlg.SetupWindow;
var
    FileSpec: array[0..10] of Char;
begin
    DlgDirList(HWindow, GetCurDir(Buffer, 0), id_ExeDirbox, id_ExePrompt,
      $C010);
    DlgDirList(HWindow, '*.exe', id_ExeFilebox, id_ExeFilePrompt, $0000);
    StrCopy(FileSpec, '*.com');
    SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000,
      Longint(@FileSpec));
    StrCopy(FileSpec, '*.bat');
    SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000,
      Longint(@FileSpec));
    StrCopy(FileSpec, '*.pif');
    SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000,
      Longint(@FileSpec));
end;

procedure TExeDlg.MsgExeDirbox(var Msg: TMessage);
begin
    if Msg.LParamHi = lbn_DblClk then
      TExeDlg.Ok(Msg);
end;

procedure TExeDlg.MsgExeFilebox(var Msg: TMessage);
begin
    if Msg.LParamHi = lbn_DblClk then
        TExeDlg.Ok(Msg);
end;

procedure TExeDlg.Ok(var Msg: TMessage);
var
    FileSpec: array[0..10] of Char;
    Len: Integer;
begin
    Buffer[0] := #0;
  DlgDirSelect(HWindow, Buffer, id_ExeDirbox);
  if StrIComp(Buffer, '') > 0 then
  begin
        FileExpand(Buffer, Buffer);
        DlgDirList(HWindow, Buffer, id_ExeDirbox, id_ExePrompt, $C010);
        DlgDirList(HWindow, '*.exe', id_ExeFilebox, id_ExeFilePrompt, $0000);
        StrCopy(FileSpec, '*.com');
        SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000, Longint(@FileSpec));
        StrCopy(FileSpec, '*.bat');
        SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000, Longint(@FileSpec));
        StrCopy(FileSpec, '*.pif');
        SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000, Longint(@FileSpec));
    end
  else
  begin
      DlgDirSelect(HWindow, Buffer, id_ExeFilebox);
    if StrIComp(Buffer, '') > 0 then
    begin
        FileExpand(Buffer, Buffer);
        Len := StrLen(Buffer) - 1;
        if Buffer[Len] = '\' then
            Buffer[Len] := #0;
        TDialog.Ok(Msg);
    end;
  end;
end;

{ ---- TSaveAsDlg methods ---------------------------------------------- }

constructor TSaveAsDlg.Init(AParent: PWindowsObject; ABuffer: PChar);
begin
    TDialog.Init(AParent, PChar(id_SaveAsDlg));
  Buffer := ABuffer;
    NameBox := New(PEdit, InitResource(@Self, id_Namebox, PrgManItm+1));
end;

procedure TSaveAsDlg.SetupWindow;
begin
    TDialog.SetupWindow;
  NameBox^.Insert(Buffer);
end;

function TSaveAsDlg.CanClose: Boolean;
begin
    NameBox^.GetText(Buffer, PrgManItm+1);
  if StrIComp(Buffer, ' ') < 1 then
      CanClose := FALSE
  else
      CanClose := TRUE;
end;

{ ---- TSctnDlg methods ------------------------------------------------ }

constructor TSctnDlg.Init(AParent: PWindowsObject; ABuffer: PChar;
    ABufferSize: Word);
begin
    TDialog.Init(AParent, PChar(id_SctnDlg));
  Buffer := ABuffer;
  BufferSize := ABufferSize;
    SctnList := New(PListbox, InitResource(@Self, id_SctnList));
  OkBtn := New(PButton, InitResource(@Self, id_Ok));
end;

procedure TSctnDlg.SetupWindow;
var
    AFile: Text;
  FullIniName: array[0..fsPathName] of Char;
    Buf, OutBuf: array[0..160] of Char;
    i, Len: Integer;
  SectionsFound: boolean;
begin
    TDialog.SetupWindow;
  GetWindowsDirectory(FullIniName, fsPathName+1);
  StrLCat(FullIniName, '\', fsPathName+1);
  StrLCat(FullIniName, IniName, fsPathName+1);
  {$I-}
    assign(AFile, FullIniName);
    Reset(AFile);
  {$I+}
  if IOResult <> 0 then
  begin
      StrLCopy(Buf, 'File Clerk could not find ', 160);
    StrLCat(Buf, StrUpper(IniName), 160);
    StrLCat(Buf, '. It made a new copy in the Windows directory.', 160);
      MessageBox(HWindow, Buf, 'File error', mb_IconExclamation or mb_Ok);
    Rewrite(AFile);
    EndDlg(id_Cancel);
    exit;
  end;
  SectionsFound := FALSE;
    while not Eof(AFile) do
    begin
        Readln(AFile, Buf);
        Len := StrLen(Buf);
        if (Buf[0]='[') and (Buf[Len-1]=']') then
    begin
            SctnList^.AddString(StrLower(
                StrLCopy(OutBuf, @Buf[1], Len-2)));
      SectionsFound := TRUE;
    end;
    end;
    Close(AFile);
    EnableWindow(OkBtn^.HWindow, SectionsFound);
end;

procedure TSctnDlg.CMSctnList(var Msg: TMessage);
begin
    if Msg.LParamHi = lbn_DblClk then
        TSctnDlg.Ok(Msg);
end;

function TSctnDlg.CanClose: Boolean;
begin
    if SctnList^.GetSelIndex >= 0 then
    begin
        SctnList^.GetSelString(Buffer, BufferSize);
        CanClose := True;
    end
  else CanClose := False;
end;

{ ---- TPmGroup methods ------------------------------------------------ }

constructor TPmGroup.Init;
begin
    TObject.Init;
end;

procedure TPmGroup.NextGroup(AFilename: PChar);
var Fp: File;
    WOffset : Word;

  Procedure ReadStr(S: PChar);
    var I:Integer;
        Ch: Char;
    begin
       I := 0;
       Repeat
          BlockRead(Fp, Ch, 1);  { Read next character }
          S[I] := Ch;
          inc(I)
       Until Ch = #0
    end;

begin
   Assign(Fp, AFilename);
   {$I-} Reset(Fp, 1); {$I+}
   if IOResult = 0 then
   begin
      StrCopy(Filename, AFilename);
      Seek(Fp, $16);                  { Go to offset to Group Title }
      BlockRead(Fp, WOffset, 2);      { Read the Offset }
      Seek(Fp, WOffset);
      ReadStr(Title);             { Read a Null Terminated String }
            Close(Fp)
   end
end;

{ ---- TInstallDlg methods -------------------------------------------- }

constructor TInstallDlg.Init(AParent: PWindowsObject;
    ASectionName, AnItm, AGrp: PChar);
begin
    TDialog.Init(AParent, PChar(id_SetupDlg));
  SectionName := ASectionName;
  TheItm := AnItm;
  TheGrp := AGrp;
  ItmEdit := New(PEdit, InitResource(@Self, id_ItmEdit, PrgManItm+1));
  GrpCombo := New(PCombobox, InitResource(@Self, id_GrpCombo, PrgManGrp+1));
  ServerWindow := 0;
  PendingMessage := 0;
end;

procedure TInstallDlg.SetupWindow;

  procedure GetGroups;
  type
      TBuffer  = Array[0..1023] of Char;
    PBuffer  = ^TBuffer;
  var
      Group         : PPMGroup;
    BP             : PChar;
      Filename : Array[0..98] of char;
      I        : Integer;

  begin
     Group := New(PPMGroup, Init);
     GetMem(BP, Sizeof(TBuffer));
     if BP <> NIL then
     begin
         GetPrivateProfileString('GROUPS', NIL, NIL,
                 BP, sizeof(TBuffer)-1, 'PROGMAN.INI');
         I := 0;
         While BP[i] <> #0 do
         begin
                GetPrivateProfileString('GROUPS', @BP[i], NIL,
                    Filename, sizeof(Filename)-1, 'PROGMAN.INI');
          Group^.NextGroup(Filename);
          GrpCombo^.AddString(Group^.Title);
                inc(I, 1+StrLen(@BP[I]))
         end;
       FreeMem(BP, Sizeof(TBuffer));
     end;
  end;

begin
   TDialog.SetupWindow;
   GetGroups;
   GrpCombo^.SetSelIndex(0);
   ItmEdit^.SetText(SectionName);
   InitiateDDE;
end;

procedure TInstallDlg.CMInstall(var Msg: TMessage);
const
  sCreateGroup = '[CreateGroup(%s)]';
  sAddItem = '[AddItem(%s, %s)]';
type
    CmdArray = array[0..1] of PChar;
var
  Executed: Boolean;
  I, L: Integer;
  HCommands: THandle;
  PGrp, PCmd, PItm, PCommands: PChar;
  GrpName, ItmName: array[0..63] of Char;
  CmdName: array[0..fsPathName+63] of Char;
  CmdAr: CmdArray;
begin
  GrpCombo^.GetSelString(GrpName, Sizeof(GrpName)-1);
  ItmEdit^.GetText(ItmName, Sizeof(ItmName)-1);
  StrPCopy(CmdName, ParamStr(0));
  StrCat(CmdName, ' ');
  StrCat(CmdName, SectionName);
  CmdAr[0] := CmdName;
  CmdAr[1] := ItmName;
  Executed := False;
  if (ServerWindow <> 0) and (PendingMessage = 0) then
  begin
    L := StrLen(GrpName) + (Length(sCreateGroup) - 1) +
      StrLen(ItmName) + StrLen(CmdName) + (Length(sAddItem) - 1);
    HCommands := GlobalAlloc(gmem_Moveable or gmem_DDEShare, L);
    if HCommands <> 0 then
    begin
      PCommands := GlobalLock(HCommands);
      PGrp := GrpName;
      WVSPrintF(PCommands, sCreateGroup, PGrp);
      PCommands := StrEnd(PCommands);
      PCmd := CmdName;
      PItm := ItmName;
      WVSPrintF(PCommands, sAddItem, CmdAr[0]);
      GlobalUnlock(HCommands);
      if PostMessage(ServerWindow, wm_DDE_Execute, HWindow,
        MakeLong(0, HCommands)) then
      begin
        PendingMessage := wm_DDE_Execute;
        Executed := True;
        StrCopy(TheItm, ItmName);
        StrCopy(TheGrp, GrpName);
      end else GlobalFree(HCommands);
    end;
    if not Executed then
      MessageBox(HWindow, 'Program Manager DDE execute failed.',
        'Error', mb_IconExclamation or mb_Ok);
  end;
  TDialog.Ok(Msg);
end;

procedure TInstallDlg.WMDDEAck(var Msg: TMessage);
begin
  case PendingMessage of
    wm_DDE_Initiate:
      begin
        if ServerWindow = 0 then
          ServerWindow := Msg.WParam
        else
          PostMessage(Msg.WParam, wm_DDE_Terminate, HWindow, 0);
        GlobalDeleteAtom(Msg.LParamLo);
        GlobalDeleteAtom(Msg.LParamHi);
      end;
    wm_DDE_Execute:
      begin
        GlobalFree(Msg.LParamHi);
        PendingMessage := 0;
        SetFocus(HWindow);
      end;
  end;
end;

procedure TInstallDlg.WMDDETerminate(var Msg: TMessage);
begin
  if Msg.WParam = ServerWindow then TerminateDDE;
end;

procedure TInstallDlg.WMDestroy(var Msg: TMessage);
begin
  TerminateDDE;
  TDialog.WMDestroy(Msg);
end;

procedure TInstallDlg.InitiateDDE;
var
  AppAtom, TopicAtom: TAtom;
begin
  PendingMessage := wm_DDE_Initiate;
  AppAtom := GlobalAddAtom('PROGMAN');
  TopicAtom := GlobalAddAtom('PROGMAN');
  SendMessage(HWnd(-1), wm_DDE_Initiate, HWindow,
    MakeLong(AppAtom, TopicAtom));
  GlobalDeleteAtom(AppAtom);
  GlobalDeleteAtom(TopicAtom);
  PendingMessage := 0;
  if ServerWindow = 0 then
    MessageBox(HWindow, 'Cannot establish DDE link to Program Manager.',
      'Error', mb_IconExclamation or mb_Ok);
end;

procedure TInstallDlg.TerminateDDE;
var
  W: HWnd;
begin
  W := ServerWindow;
  ServerWindow := 0;
  if IsWindow(W) then PostMessage(W, wm_DDE_Terminate, HWindow, 0);
end;

end.